;;; 動画ページのJavaScriptにある、swfArgsからvideo_idとtを取得し、両方をhttp://y
;;; outube.com/get_video.phpにGETで送りFLVを取得
;;; 
;;; 使用例
;;; (mapc (lambda (u)
;;; 	(format t "~A Started...~%" u)
;;; 	(get-flv-to-file-interactive u (merge-pathnames "Desktop/" (user-homedir-pathname)))
;;; 	(format t "Done...~%"))
;;;       '("http://jp.youtube.com/watch?v=E4PYJhh8ooo" ...))
(require :cl-ppcre)

(defpackage #:setagaya.youtube.mc
  (:nicknames #:youtube)
  (:use #:cl #:series #:drakma)			;and cl-ppcre
  (:export #:get-flv-to-file 
	   #:get-flv-to-file-interactive ;インタラクティブというよりちょっと状況を表示してくれるだけ
	   #:extruct-links))

(in-package #:youtube)

(defun get-video_id-&-title (uri)
  (with-input-from-string (line (http-request uri))
    (let ((id-scanner (ppcre:create-scanner "video_id:'\([0-9A-z\-_]{11}\)'.*,t:'\([0-9A-z\-_]{32}\)'"))
	  (title-scanner (ppcre:create-scanner "vidTitle\">\(.*\)</div>")))
      (flet ((rl () (read-line line nil :eof))
	     (latch (data scanner line)
	       (or data (nth-value 1 (ppcre:scan-to-strings scanner line)))))
	(do ((l (rl) (rl))
	     (id+tee nil (latch id+tee id-scanner l))
	     (title nil (latch title title-scanner l)))
	    ((eq :eof l))
	  (when (and id+tee title)
	    (let ((video_id (aref id+tee 0))
		  (tee (aref id+tee 1))
		  (title (ppcre:regex-replace-all "&quote;" ;&quoteを#\'に直す。
						  (ppcre:regex-replace-all "/" (aref title 0) "-") "'"))) ;ファイル名の"/"をエスケープ
	      (return (values video_id tee title)))))))))

(defun decode-flv-uri (uri)
  (multiple-value-bind (id tee title ) (get-video_id-&-title uri)
    (values (concatenate 'string "http://youtube.com/get_video.php" "?video_id=" id "&t=" tee) title)))

(defun get-flv-to-file (uri path)
  (with-open-stream (in (http-request (decode-flv-uri uri) :want-stream t))
    (with-open-file (out path :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
      (collect-stream out (scan-stream in #'read-byte) #'write-byte))))

(defun get-flv-to-file-interactive (uri dir)
  (multiple-value-bind (flv-uri title) (decode-flv-uri uri)
    (with-open-stream (in (http-request flv-uri :want-stream t))
      (let ((file (concatenate 'string dir title ".flv")))
	(format t "connect...~A~%" uri)
	(format t "Save file to ~A~%" file)
	(with-open-file (out file :direction :output
			          :if-exists :supersede
				  :element-type '(unsigned-byte 8))
	  (collect-stream out (scan-stream in #'read-byte) #'write-byte))
	(format t "Done...~%")))))

;; 検索結果等のページからflvへのリンクを抽出
(defun extruct-links (uri)
  (with-input-from-string (line (http-request uri))
    (let ((scanner (ppcre:create-scanner "watch\\?v=")))
      (flet ((rl () (read-line line nil :eof)))
	(do ((l (rl) (rl))
	     res)
	    ((eq :eof l) (nreverse res))
	  (let ((v (nth-value 1 (ppcre:scan-to-strings scanner l))))
	    (when v
	      (pushnew (concatenate 'string "http://jp.youtube.com"
				    (aref (nth-value 1 (ppcre:scan-to-strings ".*\(/watch\\?v=.{11}\)\".*" l)) 0))
		       res :test #'equal))))))))

;; 使用例
;; (get-flv-to-file-interactive URL 保存場所
;;
;; (mapc (lambda (u)
;; 	(format t "~A Started...~%" u)
;; 	(get-flv-to-file-interactive u (merge-pathnames "Desktop/" (user-homedir-pathname)))
;; 	(format t "Done...~%"))
;;       (extruct-links "http://jp.youtube.com/results?search_query=jerry+bergonzi&search=%E6%A4%9C%E7%B4%A2"))
